home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / testcontrast.pro < prev    next >
Text File  |  1997-07-08  |  1KB  |  68 lines
  1. ; $Id: testcontrast.pro,v 1.2 1997/01/15 04:02:19 ali Exp $
  2. ;
  3. ;  Copyright (c) 1991-1997, Research Systems Inc.  All rights
  4. ;  reserved. Unauthorized reproduction prohibited.
  5.  
  6.  
  7. function testcontrast, A, unit
  8. ;testcontrast tests that the array A consists
  9. ;of contrasts-- ie the sum of each row is zero.
  10. ;input: 
  11. ;     A = two-dimensional array
  12. ;output:
  13. ;    return 1 if A consists of contrasts and
  14. ;           0, if rows dont sum to 0
  15. ;           -1, if 0 contrast or wrong dimensions
  16.  
  17.  if(N_ELEMENTS(unit) eq 0) THEN unit = -1
  18.  SC = size(A)
  19.  if (SC(0) NE 2 and SC(0) NE 1) THEN BEGIN
  20.   printf,unit, 'testcontrast--- contrast array must be one or two-dimensional'
  21.   return,-1
  22.  END
  23.  
  24.  C = SC(1)
  25.  if( SC(0) EQ 2) THEN BEGIN
  26.   T = Replicate(1.0,C) # A
  27.   Here = where(T NE 0,count)
  28.   if count NE 0 THEN $
  29.    return,0          $
  30.   ELSE BEGIN
  31.    T = Replicate(1.0,C) # A^2
  32.    Here = where(T EQ 0,count)
  33.  
  34.    if count NE 0 THEN BEGIN
  35.     printf,unit, 'testcontrast--- invalid 0 contrast'
  36.     return,-1
  37.    ENDIF else return,1
  38.  
  39.   ENDELSE
  40.  ENDIF
  41.   
  42.   if Total(A) NE 0 THEN return,0
  43.   if Total(A^2) EQ 0 THEN BEGIN
  44.     printf,unit, 'testcontrast--- invalid 0 contrast'
  45.     return,-1
  46.   ENDIF
  47.  
  48.  return,1
  49.  
  50. END
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.